home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / shazam.exe / GSTRING.IMP < prev    next >
Text File  |  1992-09-01  |  37KB  |  1,033 lines
  1.    {*******************************************************************
  2.  
  3.    GSTRING.IMP
  4.  
  5.    *******************************************************************}
  6.    {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
  7.  
  8.                               *** TEXT ***
  9.  
  10.    |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  11.    {===================================================================
  12.  
  13.    BLANK - TRUE if blank or WhiteSpace
  14.  
  15.    ===================================================================}
  16. function IsBlank ( S : string ) : boolean ;
  17. var
  18.    x                         : byte ;
  19. begin
  20.    IsBlank                   := FALSE ;
  21.    for x := 1 to length ( S ) do
  22.       if S [ x ] <> #32 then EXIT ;
  23.    IsBlank                   := TRUE ;
  24. end ;
  25.    {===================================================================
  26.  
  27.    DUP - Return string of length "Len" of char "Ch"
  28.  
  29.    ===================================================================}
  30. function StrDup ( Ch : char ; len : byte ) : string ;
  31. var
  32.    S                         : string ;
  33. begin
  34.    FillChar ( S [ 1 ] , 255 , Ch ) ;
  35.    S [ 0 ]                   := chr ( len ) ;
  36.    StrDup                    := S ;
  37. end ;
  38.    {===================================================================
  39.  
  40.    CASE (to upper)
  41.  
  42.    ===================================================================}
  43. function StrUpCase ( S : string ) : string ;
  44. var
  45.    b                         : byte ;
  46. begin
  47.    for b := 1 to length ( S ) do
  48.       S [ b ]                := UpCase ( S [ b ] ) ;
  49.    StrUpCase                 := S ;
  50. end ;
  51.    {===================================================================
  52.  
  53.    CASE (to lower)
  54.  
  55.    ===================================================================}
  56. function LoCase ( Ch : char ) : char ;
  57. begin
  58.    if Ch in [ 'A'..'Z' ] then
  59.       LoCase                 := Chr ( Ord ( Ch ) + 32 )
  60.    else
  61.       LoCase                 := Ch ;
  62. end ;
  63.    {===================================================================
  64.  
  65.    CASE (to lower)
  66.  
  67.    ===================================================================}
  68. function StrLoCase ( S : string ) : string ;
  69. var
  70.    x                         : byte ;
  71. begin
  72.    for x := 1 to length ( S ) do
  73.       S [ x ]                := LoCase ( S [ x ] ) ;
  74.    StrLoCase                 := S ;
  75. end ;
  76.    {===================================================================
  77.  
  78.    CAPITALS - 1st letter only
  79.  
  80.    ===================================================================}
  81. function Capitalize ( S : string ) : string ;
  82. var
  83.    x                         : byte ;
  84. begin
  85.    Capitalize                := S ;
  86.    for x := 1 to length ( S ) do
  87.       if S [ x ] in [ 'a'..'z' , 'A'..'Z' ] then
  88.       begin
  89.          S [ x ]             := UpCase ( S [ x ] ) ;
  90.          Capitalize          := S ;
  91.          EXIT ;
  92.       end ;
  93. end ;
  94.    {===================================================================
  95.  
  96.    CAPITAL - all words (after each non-alpha)
  97.  
  98.    ===================================================================}
  99. function InitialCaps ( S : string ) : string ;
  100. var
  101.    DoCap                     : boolean ;
  102.    x                         : byte ;
  103. begin
  104.    DoCap                     := S [ 1 ] in [ 'a'..'z' , 'A'..'Z' ] ;
  105.    for x := 1 to length ( S ) do
  106.    begin
  107.       if DoCap then
  108.       begin
  109.          S [ x ]             := UpCase ( S [ x ] ) ;
  110.          DoCap               := FALSE ;
  111.       end ;
  112.       if not ( S [ x ] in [ 'a'..'z' , 'A'..'Z' ] ) then
  113.          DoCap               := TRUE ;
  114.    end ;
  115.    InitialCaps               := S ;
  116. end ;
  117.    {===================================================================
  118.  
  119.    PAD - increase to length "Len" with leading chars
  120.  
  121.    ===================================================================}
  122. function PadLeft ( S : string ; Ch : char ; Len : byte ) : string ;
  123. begin
  124.    while length ( S ) < len do
  125.       S                      := Ch + S ;
  126.    PadLeft                   := S ;
  127. end ;
  128.    {===================================================================
  129.  
  130.    PAD - increase to length "Len" with trailing chars
  131.  
  132.    ===================================================================}
  133. function PadRight ( S : string ; Ch : char ; Len : byte ) : string ;
  134. begin
  135.    while length ( S ) < len do
  136.       S                      := S + Ch ;
  137.    PadRight                  := S ;
  138. end ;
  139.    {===================================================================
  140.  
  141.    PUT - add leading chars
  142.  
  143.    ===================================================================}
  144. function PutLeft ( S : string ; Ch : char ; Count : byte ) : string ;
  145. begin
  146.    PutLeft                   := StrDup ( Ch , Count ) + S ;
  147. end ;
  148.    {===================================================================
  149.  
  150.    PUT - add trailing chars
  151.  
  152.    ===================================================================}
  153. function PutRight ( S : string ; Ch : char ; Count : byte ) : string ;
  154. begin
  155.    PutRight                  := S + StrDup ( Ch , Count ) ;
  156. end ;
  157.    {===================================================================
  158.  
  159.    COPY - Start to Stop, versus Start & Quantity
  160.           NOTE:  Returns blank on invalid index
  161.    ===================================================================}
  162. function CopyPos ( S : string ; Start , Stop : integer ) : string ;
  163. begin
  164.    CopyPos                   := '' ;
  165.    if Stop >= Start then
  166.       if Start > 0 then
  167.          CopyPos             := Copy ( S ,
  168.                                        Start ,
  169.                                        Stop - Start + 1 ) ;
  170. end ;
  171.    {===================================================================
  172.  
  173.    DELETE - Start to Stop, versus Start & Quantity
  174.             NOTE:  Return original on invalid index
  175.  
  176.    ===================================================================}
  177. function DeletePos ( S : string ; Start , Stop : integer ) : string ;
  178. begin
  179.    if Stop >= Start then
  180.       if Start > 0 then
  181.          delete ( S , Start , Stop - Start + 1 ) ;
  182.    DeletePos                 := S ;
  183. end ;
  184.    {===================================================================
  185.  
  186.    TRUNCATE - Delete from Index to end of string
  187.  
  188.    ===================================================================}
  189. function Truncate ( Source : string ; Index : byte ) : string ;
  190. begin
  191.    Truncate                  := DeletePos ( Source ,
  192.                                             Index ,
  193.                                             length ( Source ) ) ;
  194. end ;
  195.    {===================================================================
  196.  
  197.    MATCH - return position, ignore case
  198.  
  199.    ===================================================================}
  200. function Match ( SubStr , Target : string ) : integer ;
  201. begin
  202.    if length ( SubStr ) > 0 then
  203.       Match                  := pos ( StrUpCase ( SubStr ) ,
  204.                                       StrUpCase ( Target ) )
  205.    else
  206.       Match                  := 0 ;
  207. end ;
  208.    {===================================================================
  209.  
  210.    EXIST - if "SubStr" in "Target"; ignores case
  211.  
  212.    ===================================================================}
  213. function StrExist ( SubStr , Target : string ) : boolean ;
  214. begin
  215.    StrExist                  := Match ( SubStr , Target ) > 0 ;
  216. end ;
  217.    {===================================================================
  218.  
  219.    COUNT - number of occurances
  220.  
  221.    ===================================================================}
  222. function StrCount ( SubStr , S : string ) : integer ;
  223. var
  224.    x                         : integer ;
  225.    Index                     : integer ;
  226. begin
  227.    x                         := 0 ;
  228.    while TRUE do
  229.    begin
  230.       Index                  := Match ( SubStr , S ) ;
  231.       if Index = 0 then
  232.       begin
  233.          StrCount            := x ;
  234.          EXIT ;
  235.       end ;
  236.       inc ( x ) ;
  237.       delete ( S , Index , Length ( SubStr ) ) ;
  238.    end ;
  239. end ;
  240.    {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
  241.  
  242.    TRIM
  243.  
  244.    ||||||||||